eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}'
    & eval 'exec perl -w -S $0 $argv:q'
    if 0;
use strict;

###
### Tavor old MLX format convertor
### ------------------------------
###


### Globals:
my $version = "1.0";
my @orig_order; 
my %start_info;              # Key - Executable name
                             # Value - array reference [beg, end, start, CR-field]
my %sym;                     # Key - Executable name
                             # Value - hash reference to symbol/address pairs
my %cr;                      # Key - CR-Space name
                             # Value - array reference [offs, bitoffs, bitsize]
my %sflags;                  # Key - section name
                             # Value - hash reference w/ flags
my %sects;                   # Key - section name
                             # Value - array reference with setcion contents
my %enums;                   # Key - parameter name
                             # Value - enum contents

my %groups;                  # Key - parameter's refname
                             # Value - parameter's groups

die "Usage:\n\t".__FILE__." <devtype> <OLD-MLX-FILE> [OUTPUT-XML-FILE]\n\n".
    "Description:\n\tConvert files from old MLX format to Mimage format\n".
    "devtype = MT23108|MT25208|MT25218|MT24204|MT25204\n"
    if ((scalar(@ARGV) != 3 && scalar(@ARGV) != 2) || grep(/^(-h|--help)$/,@ARGV) || 
       ($ARGV[0] ne "MT23108" && 
        $ARGV[0] ne "MT25208" &&
        $ARGV[0] ne "MT25218" &&
        $ARGV[0] ne "MT24204" &&
        $ARGV[0] ne "MT25204" ));

my $dev   = shift;
my $fname = shift;
my $xml_file = "";
open IN, $fname or die "Couldn't open file \"$fname\" for reading: $!\n";

if (scalar(@ARGV) != 0) {
   $xml_file = shift;
   open OUT, ">$xml_file" or die "Couldn't open file \"$xml_file\" for writing: $!\n";
} else {
   *OUT = *STDOUT;
}


###
### Read input file
### ---------------
###
my $in_section = 0;
my $curr_sect = [];
my $curr_name = "";
my $in_comment = 0;
while (<IN>)
{
    if (m/^\s*\<!--/) {
       die "-E- Nested comment\n" if ($in_comment);
       $in_comment = 1;
    }

    if (m/^\s*-->/) {
       die "-E- Comment end withoun start\n" unless ($in_comment);
       $in_comment = 0;
    }

    next if $in_comment;

    if ($in_section) {
        if (/^\<\/section\>\s*$/) {
            $sects{$curr_name} = $curr_sect;
            $in_section = 0;
            $curr_sect = [];
        } else {
            push @{$curr_sect}, $_;
        }
    } else {
        if (/^\<section\s+name="([^"]+)"\s*([^>]+)?\>\s*$/) { #"""
            $in_section = 1;
            $curr_name = $1;
            push @orig_order, $curr_name;
            if (defined($2) and $2 =~ /type\s*=\s*\"bin\"/) {
                $sflags{$curr_name} = {"bin" => 1};
            } else {
                $sflags{$curr_name} = {"bin" => 0};
            }
        }
    }
}
close IN;

###
### Analize and build internal data structures
### ------------------------------------------
###

### CR-Space dictionary
die "No CR-SPACE found!\n" unless exists $sects{'CR_SPACE'};
foreach my $s (@{$sects{'CR_SPACE'}}) {
    my @f;
    die "$s - Invalid CR-Space entry.\n" unless (@f = split(/\s/,$s)) == 3;
    my ($name,$alloffs,$bitsize) = @f;
    my @f1 = split /\./, $alloffs;
    my $offs = $f1[0];
    my $bitoffs = $f1[1] || 0;
    $bitsize = 32 if ($bitsize eq "96");  # see Issue #: 24350 in Tavor FW
    $cr{$name} = [$offs, $bitoffs, $bitsize];
}
#### +++ DEBUG
#foreach my $s (keys %cr) {
#    print "\"$s\" = $cr{$s}->[0], $cr{$s}->[1], $cr{$s}->[2]\n";
#}
#### --- DEBUG

### Symtables
foreach my $s (keys %sects) {
    next unless $s =~ /^(.*?)\.symtable$/;
    my $exename = $1;
    foreach my $l (@{$sects{$s}}) {
        my @f;
        die "$l - Invalid symtable entry.\n" unless (@f = split(/\s/,$l)) == 2;
        $sym{$exename}->{$f[1]} = $f[0];
    }
}
#### +++ DEBUG
#foreach my $s (keys %sects) {
#    next unless $s =~ /^(.*?)\.image$/;
#    my $exename = $1;
#    foreach my $a (sort keys %{$sym{$exename}}) {
#        print "$exename: $a -> $sym{$exename}->{$a} \n";
#    }
#}
#### --- DEBUG

### Get beg/eng/start/CR-Space_start info from General section
foreach my $l (@{$sects{'General'}}) {
    my @f;
    die "$l - Invalid General entry.\n" unless (@f = split(/\s/,$l)) == 5;
    $start_info{$f[3]} = [$f[0], $f[1],$f[2], $f[4]];
}

### Check that it specified for each executable
foreach my $s (keys %sects) {
    next unless $s =~ /^(.*?)\.image$/;
    my $exename = $1;
    die "No info in General section about $s\n" unless exists $start_info{$exename};
}
#### +++ DEBUG
#foreach my $e (sort keys %start_info) {
#    my $s = $start_info{$e};
#    print "$e: $s->[0], $s->[1], $s->[2], $s->[3], \n";
#}
#### --- DEBUG

#
# Remove perl comments - patch - In arbel these comments contain non ascii characters which kill expat.
#

my $in_perl = 0;
foreach (@{$sects{'TEMTParameters'}}) {
   last if m|</PERL>|;
   $in_perl = 1 if m|<PERL>|;
   
   s/^\s*#.*$// if $in_perl;

} 


###
### Fix parameters section
### ----------------------
###

# Put param attributes in single line:
my $par_sect = [];
my $one_line_par = "";
my $in_par = 0;
foreach (@{$sects{'TEMTParameters'}}) {
   chomp;
   # seperate 2 params in same line:
   if (m/^(.+)<par\s/) {
      if ($in_par) {
         push (@{$par_sect}, "$one_line_par$1\n");
         $one_line_par = "";
      } else {
         push (@{$par_sect}, "$1\n");
      }

      s/^(.+)(<par\s.*$)/$2/;
   }

   if (m/^\s*<par / && (! m/>/)) {
      if ($in_par) {
         push (@{$par_sect}, "$one_line_par\n");
         # print STDERR "-D- To line      : $one_line_par\n";
         $one_line_par = "";   
      }
      $in_par = 1;
   } elsif ($in_par && (m/^\s*</)) {
      $in_par = 0;
      push (@{$par_sect}, "$one_line_par\n");
      # print STDERR "-D- To line      : $one_line_par\n";
      $one_line_par = "";
   }

   if ($in_par) {
      # print STDERR "-D- Unifying line: $_\n";
      $one_line_par .= " $_";
   } else {
      push (@{$par_sect}, "$_\n");
   }
}

$sects{'TEMTParameters'} = $par_sect;

# Split multy cr/c regs parameters:
$par_sect = [];
foreach (@{$sects{'TEMTParameters'}}) {
   if (m/\s+(CRnames|cname)\s*=\s*"([^"]+)"/) {
      my $n = $1;
      my $val = $2;
      my $par = $_;
      my @f = split(/,/,$val);
      # print STDERR "-D- Splitting: $_\n" if (scalar(@f) > 1);
      foreach (@f) {
         my $npar = $par;
         $npar =~ s/\s+$n\s*=\s*"[^"]+"/ $n="$_"/;
         push @{$par_sect}, $npar;
         # print STDERR "-D- To       : $npar\n" if (scalar(@f) > 1);
      }
   } else {
      push @{$par_sect}, $_;
   }
}
$sects{'TEMTParameters'} = $par_sect;



# Extract all enums
my $cur_par = "";
foreach (@{$sects{'TEMTParameters'}}) {
    if (/\s+name\s*=\s*"([^"]+)"/) { #"
        $cur_par = $1;
        $cur_par =~ s/[ \t\r\n\/.,]+//g;
    } elsif (/\<\s*enum\s+([^\/]+)\//) {
        $enums{$cur_par} = "" unless defined $enums{$cur_par};
        my $e_vals = $1;
        while ($e_vals =~ m/^(\S+\s*=\s*"[^"]+")\s*/) {
           my $e = $1;
           my $n = $e;
           $n =~ s/=.*$//;     # enum val name
           $e =~ s/="/="0x/g;  # enum exoression
           $enums{$cur_par} .= "    $e\n" unless ($enums{$cur_par} =~ m/$n/);

           $e_vals =~ s/^(\S+\s*=\s*"[^"]+")\s*//;
        }
    }
}

# Extract groups for refnames
my $cur_group;
foreach (@{$sects{'TEMTParameters'}}) {
   if (m/\<\s*tab\s+name\s*=\s*"([^"]+)"/) {
      $cur_group = $1;
      $cur_group =~ s/[\/\\ .]/_/g;
      s/name\s*=\s*"([^"]+)"/name="$cur_group"/;
   }

   if (m/\srefname\s*=\s*"([^"]+)"/) {
      $groups{$1} = $cur_group;
   }
}

# Fix perl refnames to GROUP.refname:
# foreach (@{$sects{'TEMTParameters'}}) {
#    last if m|</PERL>|;
#    if (m/REF\{.+REF\{/) {
#       print STDERR "-W- Can't handl e 2 REFs in same line: $_";
#       next;
#    }
#    s/\$REF\{\s*&quot;(\S+)&quot;\s*}/\$REF\{&quot;$groups{$1}.$1&quot;\}/;
# }


# Fix expr refnames to GROUP.refname:
# expr="(ADAPTER.adapter_ref_clock_khz+999/10000"
# expr="(adapter_ref_clock_khz+999)/1000"
# foreach (@{$sects{'TEMTParameters'}}) {
#    if (m/\sexpr\s*=\s*"([^"]+)"/) {
#       my $expr = $1;
#       my $fixed_expr = "";
#       
#       while ($expr =~ m/^([^A-Za-z_0-9]+)*([A-Za-z_0-9]+)/) 
#       {
#          my $pre   = $1;
#          my $old   = $2;
#          my $new   = $old;
# 
#          if (defined $groups{$old}) {
#             $new   = $groups{$old}.".$old";
#          }
# 
#          $expr        =  substr($expr, length("$pre$old"));
#          $fixed_expr .= "$pre$new";
#       }
# 
#       $fixed_expr .= $expr;
# 
#       s/\sexpr\s*=\s*"[^"]+"/ expr="$fixed_expr"/;
#    }
# }


# Fix parameters
#for (my $i=0; $i < @{$sects{'TEMTParameters'}}; $i++) {
my $prev_par = "";
foreach (@{$sects{'TEMTParameters'}}) {
    # Some line-based translations
    
    # Remove leading spaces from vals
    s/\s+(\S+)\s*=\s*"\s*/ $1="/g;
    
    s/type\s*=\s*"\s*CR-SPACE\s*"/type="crspace"/;
    s/type\s*=\s*"\s*C\s*"/type="c"/;
    s/type\s*=\s*"\s*DUMMY\s*"/type="dummy"/;

    s/\<\s*tab/<group/;
    s/\<\s*\/\s*tab/<\/group/;

    s/\<\s*enum[^>]+>//;

    s/\<\s*par /<param /;
    s/\<\s*\/\s*par/<\/param/;

#    s/\s+offs(et)*\s*=\s*"/ addr="/;
    s/\s+radix\s*=\s*"/ repr="/;
    s/\s+iriscs\s*=\s*"/ exe="/;

    s/repr\s*=\s*"\s*hexa\s*"/repr="uns"/;
    s/repr\s*=\s*"\s*decimal\s*"/repr="int"/;

    # Fix infiniburn's int representations - only uints in mic
    s/\smin\s*=\s*"\s*(0x)*80000000\s*"/ min="00000000"/;
    s/\smax\s*=\s*"\s*(0x)*7fffffff\s*"/ max="ffffffff"/i;

    # Remove PERL expression
    s/\s+expr\s*=\s*"\s*PERL\s*"/ /;

    # Replqce &geq; QT directive with =<
    s/&geq;/=&gt;/g;

    # Replace package name inside embeded perl
    s/package\s+InfiniBurn\s*;/package MIC;/;
    s/tie\s+%REF\s*,\s*'InfiniBurn'/tie %REF, 'MIC'/;

    # fix bug in Arbel/Tavor mlx
    s/<set_default_props\s/<set_default_prop /;


    # Fix for specific bug in arbel: QT accepted duplicated attr - remove the second. 
    if (m/type\s*=\s*"[^>]+\stype\s*=\s*"/) {
       print STDERR ("-W- multiple type decleration for same param: \n   " ,
                      $_,
                      "   Removint second attr\n");
       s/^(.*)(type\s*=\s*"[^"]+")(.*)(type\s*=\s*"[^"]+")(.*)$/$1$2$3$5/;
    }

    # !!! Note - this specific param was put in the mlx file not inside a group
    # MIC forbids that - I simply delete this param. Need to make sure FW prep puts
    # it inside a group in future releases !!!
    if (m/^.*<param name="prepMLX version".*$/) {
       print STDERR "-W- Removing parameter defined outside a group: \"prepMLX version\".\n";
       s/^.*<param name="prepMLX version".*$//;
    }

    # Remove PERL default of fix no default (arbitrarily assign min )
    if (m/\sdef\s*=\s*"\s*PERL\s*"/ || !m/\sdef\s*=\s*"/) {
       my $min;
       if (m/\smin\s*=\s*"([^"]+)/) {
          $min = $1;
       } else {
          $min = 0;
       }
       chomp $min;
       if (m/PERL/) {
          s/\sdef\s*=\s*"\s*PERL\s*"/ def="$min"/;
       } else {
          s/ type\s*=/ def="$min" type=/;
       }
    }

    #add 0x to nums:
    if (/repr\s*=\s*"\s*uns\s*"/) {
       s/\s+(addr|min|max|def)\s*=\s*"(0x)*([^"]+)/ $1="0x$3/g;
    }

    #Problematic chars in names
    if (/name\s*=\s*"([^"]+)"/) {
       my $name = $1;
       #print STDERR qq|-D- Replaced: $_\n|;
       $name =~ s/#/_/g;
       $name =~ s/\s*$//g;
       s/name\s*=\s*"[^"]+"/name="$name"/;
       #print STDERR qq|-D- To      : $_\n|;
    }

    # Remove spaces from attributes valuse
    s/=\s*"\s*([^" ]+)\s*"/="$1"/g;


    # Enum
    if (/^(.*?)repr\s*=\s*"\s*enum\s*"(.*)$/) {
        my ($pre,$post) = ($1,$2);
        if ($pre =~ /\s+name\s*=\s*"([^"]+)"/) { #"
            my $cur_par = $1;
            $cur_par =~ s/[ \t\r\n\/.,]+//g;
            die "Enum \"$cur_par\" not found.\n" unless exists $enums{$cur_par};
            $_ = $pre . "repr=\"enum:" . $cur_par .
                "\"" . $post . "\n";
        } elsif ($post =~ /\s+name\s*=\s*"([^"]+)"/) { #"
            my $cur_par = $1;
            $cur_par =~ s/[ \t\r\n\/.,]+//g;
            die "Enum \"$cur_par\" not found.\n" unless exists $enums{$cur_par};
            $_ = $pre . "repr=\"enum:" . $cur_par .
                "\"" . $post . "\n";
        } elsif ($prev_par =~ /\s+name\s*=\s*"([^"]+)"/) { #"
            my $cur_par = $1;
            $cur_par =~ s/[ \t\r\n\/.,]+//g;
            die "Enum \"$cur_par\" not found.\n" unless exists $enums{$cur_par};
            $_ = $pre . "repr=\"enum:" . $cur_par .
                "\"" . $post . "\n";
        } else {
            printf STDERR "\nWARNING:\nParameter \"".$pre." must be with enum in same line!\n";
            printf STDERR "Line: $_\n";
        }
    }

    # CR-SPACE
    if (/^(.*?)CRnames\s*=\s*"([^"]+)"(.*)$/) { #"
       my ($pre,$nam,$post) = ($1,$2,$3);
       $nam =~ s/^(.*?)\s*$/$1/;
       my @f = split(/,/,$nam);
       if (@f > 1) {
           printf STDERR "\nWARNING:\nParameter with attribute:\nCRnames=\"$nam\"\n".
               "must be split manually!!!\n";
       } else {
           die "\nNo CR-Space definition for \"$nam\"\n" unless exists $cr{$nam};
           my $d = $cr{$nam};

           my $addr    = $d->[0];
           my $bitoffs = $d->[1];
           my $size    = $d->[2];
           
           # In infiniburn there's a special case:
           # If a cr parameter's offset attr is defined, the size is 32 bits, and the addr is 4 bytes alligned.
           # (Has to do something with SPD / VPD)

           if (m/\soffset\s*=\s*"/) {
              $size    = 32;
              $bitoffs = 0;

              if ($addr !~ m/[048cC]$/) {
                 print STDERR "-E- Address of a parameter with offset is not DW alligned: $_\n";
                 die;
              }
           }

           $_ = $pre . " addr=\"" . $addr .
               "\" bitoffs=\"" . $bitoffs . "\" size=\"" . $size . "\" " .
               $post . "\n";     

       }
    # C
    } elsif (/^(.*?)cname\s*=\s*"([^"]+)"(.*)$/) { #"
       my ($pre,$nam,$post) = ($1,$2,$3);
       $nam =~ s/^(.*?)\s*$/$1/;
       my @f = split(/,/,$nam);
       if (@f > 1) {
           printf STDERR "\nWARNING:\nParameter with attribute:\ncname=\"$nam\"\n".
               "must be split manually!!!\n";
       } else {
           if (/^(.*?)exe\s*=\s*"([^"]+)"(.*)$/) { #"
               my $nam1 = $2;
               $nam1 =~ s/^(.*?)\s*$/$1/;
               my @f1 = split(/,/,$nam1);
               if (@f1 > 1) {
                   printf STDERR "\nWARNING:\nParameter with attribute:\niriscs=\"$nam1\"\n".
                       "must be split manually!!!\n";
               } else {
                   die "\nNo symbol table for \"$nam1\"\n" unless exists $sym{$nam1};
                   my $mysym = $sym{$nam1};
                   die "\nirisc \"$nam1\" doesn't have \"$nam\" symbol definition\n"
                       unless $mysym->{$nam};
                   $_ = $pre . " addr=\"0x" .
                       $mysym->{$nam} . "\" " . $post . "\n";
               }
           } else {
               die "\nNo iriscs field for \"$nam\". Possible you\n" .
                   "need to megre a few lines arounf the definition manually.\n"
           }
       }
    }
    $prev_par = $_;
}

###
### Write output to stdout
### ----------------------
###
print OUT "<!-- $dev Firmware image\n";
print OUT "\n";
print OUT " -->\n\n";

foreach my $s (@orig_order) {
    #print "S: \"$s\"($sflags{$s}->{bin})\n";
    if ($s eq 'TEMTParameters') {

        # Auto section
        my $exename = "failsafe.exe";
        my $b0_label = "boot0_load";
        die "$b0_label not found in $exename\n"
            unless exists $sym{$exename}->{$b0_label};

        print OUT "<section name=\"FWParameters\">\n";
        print OUT "<FWParameters>\n";
        print OUT "\n";
        print OUT "<group name=\"Auto\">\n";
        print OUT "<param name=\"prepVerion\" type=\"dummy\" def=\"" . $version .
            "\" repr=\"ascii\" length=\"10\" hidden=\"1\" />\n";
        print OUT "<param name=\"boot0_load\" type=\"dummy\" def=\"0x" .
            $sym{$exename}->{$b0_label} . "\" repr=\"uns\"  hidden=\"1\" />\n";

        print OUT "</group>\n\n";

        # Enums
        foreach my $l (keys %enums) {
            print OUT "<enum name=\"",$l,"\"\n";
            print OUT $enums{$l};
            print OUT "/>\n"
        }
        print OUT "\n";

        # Rest of parameters
        foreach my $l (@{$sects{'TEMTParameters'}}) {
            print OUT "$l";
        }
        print OUT "</FWParameters>\n";
        print OUT "</section>\n\n";
    } elsif ($s =~ /^(.*?)\.symtable$/) {
        # Ignore symtable section
    } elsif ($s eq 'CR_SPACE') {
        # Ignore CR_SPACE section
    } elsif ($sflags{$s}->{bin}) {
        # Binary section
        die "\n\"$s\" is wrong binary section name.\n" unless $s =~ /^(.*?)\.image$/;
        my $exename = $1;

        # Fix boot names: MIC expects:                boot2.exe and   boot2.exe_boot3  (as was in tavor)
        # unfortunately, it was replaced in arbel to: boot.exe and   boot.exe_boot3
        my $fixed_name = $exename;
        $fixed_name =~ s/^boot\.exe/boot2.exe/;

        my $sinfo = $start_info{$exename};
        my $jump = exists $cr{$sinfo->[3]} ? $cr{$sinfo->[3]}->[0] : $sinfo->[3];
        print OUT "<bsection name=\"$fixed_name\" ";
        #if ($exename eq "failsafe.exe") {
        #    # Start address of failsafe.exe - SPECIAL CASE
        #    my $b0_label="boot0_load";
        #    die "$b0_label not found in $exename\n"
        #        unless exists $sym{$exename}->{$b0_label};
        #    print "beg=\"0x$sinfo->[0]\" start=\"0x" .
        #        $sym{$exename}->{$b0_label} . "\" end=\"0x$sinfo->[1]\" " ;
        #} else {
            print OUT "beg=\"0x$sinfo->[0]\" start=\"0x$sinfo->[2]\" end=\"0x$sinfo->[1]\" " ;
        #}
        print OUT "crstart=\"$jump\" >\n";
        foreach my $l (@{$sects{$s}}) {
            print OUT "$l";
        }
        print OUT "</bsection>\n";
    } else {
        # All other regular section
        print OUT "<section name=\"$s\">\n";
        foreach my $l (@{$sects{$s}}) {
            print OUT "$l";
        }
        print OUT "</section>\n";
    }
}

# Check that write is O.K. 
# It would be safer to check each print, but checking the last one is probably sufficient.
die "-E- Failed writing to output $xml_file: $!\n" unless print(OUT  "\n");

close OUT if ($xml_file ne "");


